
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta http-equiv="Content-Language" content="zh-cn">
</head>

<%session.codepage=65001%>
<%

  jjff=0  
  xuaszh=jjff
  
'Option Explicit 
'*********************************************** 
' 类名称：ChinaDay 
' 用途： 
' 根据输入的日期计算该日期的农历天干地支及当年属相 
' 使用方法： 
' 第一个参数为输入参数，不填写默认为当日， 
' 只计算1921-2-8之后的日期 
' ##-------------------------------------------## 
' Dim objChinaDay 
' Dim sDay, sWeekDay, sChinaDay, sChinaYear,sChinaAni 
' Set objChinaDay = New ChinaDay 
' Call objChinaDay.Action("",sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni) 
' Response.Write sDay&"<BR>" 
' Response.Write sWeekDay&"<BR>" 
' Response.Write sChinaYear&"<BR>" 
' Response.Write sChinaDay&"<BR>" 
' Response.Write sChinaAni&"<BR>" 
'******************************************************* 
Class ChinaDay 

Dim arrWeekName(7), MonthAdd(11), NongliData(99) 
Dim arrTianGan(9), arrDiZhi(11), arrShuXiang(11), arrDayName(30), arrMonName(12) 
Dim curTime, curYear, curMonth, curDay, curWeekday 
Dim i, m, n, k, isEnd, bit, TheDate 

'初始化数据 
Sub Class_Initialize() 
'--------------------------------------------------- 
'定义显示字串 

'星期名 
arrWeekName(0) = "*" 
arrWeekName(1) = "星期日" 
arrWeekName(2) = "星期一" 
arrWeekName(3) = "星期二" 
arrWeekName(4) = "星期三" 
arrWeekName(5) = "星期四" 
arrWeekName(6) = "星期五" 
arrWeekName(7) = "星期六" 

'天干名称 
arrTianGan(0) = "甲" 
arrTianGan(1) = "乙" 
arrTianGan(2) = "丙" 
arrTianGan(3) = "丁" 
arrTianGan(4) = "戊" 
arrTianGan(5) = "己" 
arrTianGan(6) = "庚" 
arrTianGan(7) = "辛" 
arrTianGan(8) = "壬" 
arrTianGan(9) = "癸" 

'地支名称 
arrDiZhi(0) = "子" 
arrDiZhi(1) = "丑" 
arrDiZhi(2) = "寅" 
arrDiZhi(3) = "卯" 
arrDiZhi(4) = "辰" 
arrDiZhi(5) = "巳" 
arrDiZhi(6) = "午" 
arrDiZhi(7) = "未" 
arrDiZhi(8) = "申" 
arrDiZhi(9) = "酉" 
arrDiZhi(10) = "戌" 
arrDiZhi(11) = "亥" 

'属相名称 
arrShuXiang(0) = "鼠" 
arrShuXiang(1) = "牛" 
arrShuXiang(2) = "虎" 
arrShuXiang(3) = "兔" 
arrShuXiang(4) = "龙" 
arrShuXiang(5) = "蛇" 
arrShuXiang(6) = "马" 
arrShuXiang(7) = "羊" 
arrShuXiang(8) = "猴" 
arrShuXiang(9) = "鸡" 
arrShuXiang(10) = "狗" 
arrShuXiang(11) = "猪" 

'农历日期名 
arrDayName(0) = "*" 
arrDayName(1) = "初一" 
arrDayName(2) = "初二" 
arrDayName(3) = "初三" 
arrDayName(4) = "初四" 
arrDayName(5) = "初五" 
arrDayName(6) = "初六" 
arrDayName(7) = "初七" 
arrDayName(8) = "初八" 
arrDayName(9) = "初九" 
arrDayName(10) = "初十" 
arrDayName(11) = "十一" 
arrDayName(12) = "十二" 
arrDayName(13) = "十三" 
arrDayName(14) = "十四" 
arrDayName(15) = "十五" 
arrDayName(16) = "十六" 
arrDayName(17) = "十七" 
arrDayName(18) = "十八" 
arrDayName(19) = "十九" 
arrDayName(20) = "二十" 
arrDayName(21) = "廿一" 
arrDayName(22) = "廿二" 
arrDayName(23) = "廿三" 
arrDayName(24) = "廿四" 
arrDayName(25) = "廿五" 
arrDayName(26) = "廿六" 
arrDayName(27) = "廿七" 
arrDayName(28) = "廿八" 
arrDayName(29) = "廿九" 
arrDayName(30) = "三十" 

'农历月份名 
arrMonName(0) = "*" 
arrMonName(1) = "正" 
arrMonName(2) = "二" 
arrMonName(3) = "三" 
arrMonName(4) = "四" 
arrMonName(5) = "五" 
arrMonName(6) = "六" 
arrMonName(7) = "七" 
arrMonName(8) = "八" 
arrMonName(9) = "九" 
arrMonName(10) = "十" 
arrMonName(11) = "十一" 
arrMonName(12) = "腊" 

'--------------------------------------------------------- 

'公差数据定义 

'公历每月前面的天数 
MonthAdd(0) = 0 
MonthAdd(1) = 31 
MonthAdd(2) = 59 
MonthAdd(3) = 90 
MonthAdd(4) = 120 
MonthAdd(5) = 151 
MonthAdd(6) = 181 
MonthAdd(7) = 212 
MonthAdd(8) = 243 
MonthAdd(9) = 273 
MonthAdd(10) = 304 
MonthAdd(11) = 334 

'农历数据 
NongliData(0) = 2635 
NongliData(1) = 333387 
NongliData(2) = 1701 
NongliData(3) = 1748 
NongliData(4) = 267701 
NongliData(5) = 694 
NongliData(6) = 2391 
NongliData(7) = 133423 
NongliData(8) = 1175 
NongliData(9) = 396438 
NongliData(10) = 3402 
NongliData(11) = 3749 
NongliData(12) = 331177 
NongliData(13) = 1453 
NongliData(14) = 694 
NongliData(15) = 201326 
NongliData(16) = 2350 
NongliData(17) = 465197 
NongliData(18) = 3221 
NongliData(19) = 3402 
NongliData(20) = 400202 
NongliData(21) = 2901 
NongliData(22) = 1386 
NongliData(23) = 267611 
NongliData(24) = 605 

NongliData(25) = 2349 
NongliData(26) = 137515 
NongliData(27) = 2709 
NongliData(28) = 464533 
NongliData(29) = 1738 
NongliData(30) = 2901 
NongliData(31) = 330421 
NongliData(32) = 1242 
NongliData(33) = 2651 
NongliData(34) = 199255 
NongliData(35) = 1323 
NongliData(36) = 529706 
NongliData(37) = 3733 
NongliData(38) = 1706 
NongliData(39) = 398762 
NongliData(40) = 2741 
NongliData(41) = 1206 
NongliData(42) = 267438 
NongliData(43) = 2647 
NongliData(44) = 1318 
NongliData(45) = 204070 
NongliData(46) = 3477 
NongliData(47) = 461653 
NongliData(48) = 1386 
NongliData(49) = 2413 
NongliData(50) = 330077 
NongliData(51) = 1197 
NongliData(52) = 2637 
NongliData(53) = 268877 
NongliData(54) = 3365 
NongliData(55) = 531109 
NongliData(56) = 2900 
NongliData(57) = 2922 
NongliData(58) = 398042 
NongliData(59) = 2395 
NongliData(60) = 1179 
NongliData(61) = 267415 
NongliData(62) = 2635 
NongliData(63) = 661067 
NongliData(64) = 1701 
NongliData(65) = 1748 
NongliData(66) = 398772 
NongliData(67) = 2742 
NongliData(68) = 2391 
NongliData(69) = 330031 
NongliData(70) = 1175 
NongliData(71) = 1611 
NongliData(72) = 200010 
NongliData(73) = 3749 
NongliData(74) = 527717 
NongliData(75) = 1452 
NongliData(76) = 2742 
NongliData(77) = 332397 
NongliData(78) = 2350 
NongliData(79) = 3222 
NongliData(80) = 268949 
NongliData(81) = 3402 
NongliData(82) = 3493 
NongliData(83) = 133973 
NongliData(84) = 1386 
NongliData(85) = 464219 
NongliData(86) = 605 
NongliData(87) = 2349 
NongliData(88) = 334123 
NongliData(89) = 2709 
NongliData(90) = 2890 
NongliData(91) = 267946 
NongliData(92) = 2773 
NongliData(93) = 592565 
NongliData(94) = 1210 
NongliData(95) = 2651 
NongliData(96) = 395863 
NongliData(97) = 1323 
NongliData(98) = 2707 
NongliData(99) = 265877 
End Sub 

'############################################################ 
'主要方法 Action 
' inDay 输入日期，如果不输入则默认为当前日期 
' sDay 中文格式日期 
' sWeekDay 周几 
' sChinaYear 农历年 
' sChinaDay 农历日 
' sChinaAni 属相 
'############################################################ 
Public Function Action(inDay,sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni) 

'转换要转换的日期 
If inDay="" Or Not IsDate(inDay) Then 
'获取当前系统时间 
curTime = Now() 
Else 
curTime = CDate(inDay) 
End If 

If Datediff("d",curTime,Cdate("1921-2-8"))>0 Then 
Exit Function 
End If 

'生成当前公历年、月、日 ==> sDay 
curYear = Year(curTime) 
curMonth = Month(curTime) 
curDay = Day(curTime) 

sDay = curYear&"年" 
If (curMonth < 10) Then 
sDay = sDay&"0"&curMonth&"月" 
Else 
sDay = sDay&curMonth&"月" 
End If 
If (curDay < 10) Then 
sDay = sDay&"0"&curDay&"日" 
Else 
sDay = sDay&curDay&"日" 
End If 

'生成当前公历星期 ==> sWeekDay 
curWeekday = Weekday(curTime) 
sWeekDay = arrWeekName(curWeekday) 

'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一) 
TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38 
If ((curYear Mod 4) = 0 AND curMonth > 2) Then 
TheDate = TheDate + 1 
End If 

'计算农历天干、地支、月、日 
isEnd = 0 
m = 0 
'------------------------------------ 
Do 
If (NongliData(m) < 4095) Then 
k = 11 
Else 
k = 12 
End if 

n = k 
'------------------------------------ 
Do 
If (n < 0) Then 
Exit Do 
End If 

'获取NongliData(m)的第n个二进制位的值 
bit = NongliData(m) 
For i = 1 To n Step 1 
bit = Int(bit / 2) 
Next 
bit = bit Mod 2 

If (TheDate <= 29 + bit) Then 
isEnd = 1 
Exit Do 
End If 

TheDate = TheDate - 29 - bit 

n = n - 1 
Loop 
'------------------------------------ 
If (isEnd = 1) Then 
Exit Do 
End If 

m = m + 1 
Loop 
'------------------------------------ 

curYear = 1921 + m 
curMonth = k - n + 1 
curDay = TheDate 

If (k = 12) Then 
If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then 
curMonth = 1 - curMonth 
ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then 
curMonth = curMonth - 1 
End if 
End If 

'生成农历天干、地支==> sChinaYear 
sChinaYear = arrTianGan(((curYear - 4) Mod 60) Mod 10)&arrDiZhi(((curYear - 4) Mod 60) Mod 12)&"年" 
'生成属相 == > sChinaAni 
sChinaAni = arrShuXiang(((curYear - 4) Mod 60) Mod 12) 

'生成农历月、日 ==> NongliDayStr 
If (curMonth < 1) Then 
sChinaDay = "闰"&arrMonName(-1 * curMonth) 
Else 
sChinaDay = arrMonName(curMonth) 
End If 
sChinaDay = sChinaDay&"月" 

sChinaDay = sChinaDay & arrDayName(curDay) 
End Function 
End Class 
%> 
<% 
Dim objChinaDay 
Dim sDay, sWeekDay, sChinaDay, sChinaYear,sChinaAni 
Set objChinaDay = New ChinaDay 
Call objChinaDay.Action(request("data"),sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni) 
Set objChinaDay = Nothing 
'Response.Write sDay&"<BR>" 
'Response.Write sWeekDay&"<BR>" 
'Response.Write sChinaYear&"<BR>" 
'Response.Write sChinaDay&"<BR>" 
'Response.Write sChinaAni&"<BR>" 

  
%>
